unit UmapMgr;

interface

uses classes, sysutils,

  Ucommon;

type
{$H-}
  Rmapdata = reCord
    fname, name, descr: string;
    fsize: integer;
    Width, Height, hdrsize: word;
  end;

  TmapMgr = class(TObject)
  private
    fcurmap : word;
    procedure Setcurmap(const Value: word);
  public
    mapar: array of Rmapdata;
    mapdir, mapext, mapsign: string;
    function Loadmaphdrs(): Integer;
    function mapqnt(): word;
    constructor Create;
    Destructor Destroy(); override;
    function mapLoad(game: tObject; mapid: byte): boolean;
    property curmap: word read fcurmap write Setcurmap;
  end;

implementation

uses Ugamesys;

{ TmapMgr }

Destructor TmapMgr.Destroy;
begin
  mapar := nil;
  inherited;
end;

function TmapMgr.Loadmaphdrs(): Integer;
var
  b: byte;
  sr: tsearchrec;
  fs: tFilestream;
  mapdat: Rmapdata;
  str: string;
begin
  mapar := nil;
  if findfirst(mapdir + '*' + mapext, faanyFile, sr) = 0 then
    repeat
      try
        mapdat.fname := mapdir + sr.Name;
        fs := tFilestream.Create(mapdat.fname, fmopenread);
        if fs = nil then
          if findnext(sr) = 0 then
            continue
          else
            break;
        {if fs.Size < 1000
          then}
        fs.read(str, length(mapsign) + 1);
        if Uppercase(str) <> mapsign then
          continue;
        fs.Read(b, sizeof(b));
        fs.seek(-1, sofromcurrent);
        fs.Read(mapdat.name, b + 1);
        fs.Read(b, sizeof(b));
        fs.seek(-1, sofromcurrent);
        fs.Read(mapdat.descr, b + 1);
        fs.Read(mapdat.Width, sizeof(mapdat.Width));
        fs.Read(mapdat.Height, sizeof(mapdat.Height));
        mapdat.hdrsize := fs.Position;
        mapdat.fsize := fs.size;
        FreeAndNil(fs);
      except
        FreeAndNil(fs);
        continue;
      end;
      Setlength(mapar, mapqnt + 1);
      mapar[mapqnt - 1] := mapdat;
    until findnext(sr) <> 0;
  findclose(sr); // release memory of tsearchrec
  result := mapqnt;
end;

function TmapMgr.mapqnt: word;
begin
  Result := Length(mapar);
end;

function TmapMgr.mapLoad(game: tObject; mapid: byte): boolean;
var
  fs: tFilestream;
  i, j {,an}: word;
  Cell : tFieldCell;
  b, b1: byte;
  po: integer;
begin
  with game as Tgame do
    if (Fileexists(mapar[mapid].fname)) then
      try
        fs := tFilestream.create(mapar[mapid].fname, fmopenread);
        fs.seek(mapar[mapid].hdrsize, sofrombeginning);
        i := 0; // Row
        j := 0; // Col
        repeat
          Cell := Field.Add(i, j);
          po := fs.Position;
          fs.read(b, sizeof(b));
          if b in [ord(low(Ntertype))..ord(High(Ntertype))] then
            Cell.tertype := Ntertype(b)
          else
            Cell.tertype := ttvoid;
          fs.read(b, sizeof(b)); // homm3 map tile aligner
          Cell.tertex := b;
          if Cell.tertype <> ttvoid then
          begin
            fs.read(b, sizeof(b));
            if (b in [succ(ord(low(NObjtype)))..ord(High(NObjtype))]) then
            begin
              fs.read(b1, sizeof(b1));
              Cell.Obj := TgameObj.create(Cell, NObjtype(b), b1);
            end;
            fs.read(b, sizeof(b));
            if (b in [succ(ord(low(Nforce)))..ord(High(Nforce))]) then
            begin
              Cell.army := armies.Add(Cell);
              Cell.army.Parties.Add;
              Cell.army.Parties.Items[Cell.army.Parties.Count - 1].force := Nforce(b);
              Cell.army.Parties.Items[Cell.army.Parties.Count - 1].Init(Cell);
            end;
          end;
          fs.Seek(po + 6, sofrombeginning); // homm3 map tile aligner
          fs.read(b, sizeof(b)); //
          Cell.fmirror := b; //

          if j = Field.Width - 1 then
          begin
            inc(i);
            j := 0;
          end
          else
            inc(j);
        until i = Field.Height;

        // here Load armies section
        curmap := mapid;
        result := true;
      except
        Field.Clearmap;
        FreeAndNil(fs);
        result := false;
      end
    else
      result := false;
  FreeAndNil(fs);
end;

constructor TmapMgr.Create;
begin
  mapdir := AppPath + 'maps\';
  mapext := '.smm';
  mapsign := 'SMSMAP';
  Loadmaphdrs;
end;

procedure TmapMgr.Setcurmap(const Value: word);
begin
  Assert(Value in [0.. mapqnt-1], 'wrong map index');
  fcurmap := Value;
end;

end.

